functor Paldoc (S : PALDOC_STRUCTS) : PALDOC =
struct
  open S
  
  structure A = Ast
  structure T = Types
  structure Err = ErrorMsg
  
  fun setfont size color str ="<font size="^(Int.toString size)^" color="^color^">"^str^"</font>"
  fun setfont2keyword str = setfont 2 "blue" str
  fun setfont2red str = setfont 2 "red" str    
  fun setline str = str^"<br>"
  fun seth2 str = "<h2>"^str^"</h2>"
  fun seth3 str = "<h3>"^str^"</h3>"
  fun inpa  str = "("^str^")"
 
  fun type2str (A.Int)  = "int"
    | type2str (A.Bool) = "bool"
    | type2str (A.Void) = "void"
    | type2str (A.Struct(sid)) = "struct "^sid
    | type2str (A.Pointer(btype)) = type2str(btype)^"*"
    | type2str (A.Array(size,btype)) = "array["^Int.toString(size)^", "^type2str(btype)^"]"
  fun tlist2str [] = ""
    | tlist2str ((aid,tp)::[]) = type2str(tp)
    | tlist2str ((aid,tp)::l) = type2str(tp)^", "^tlist2str(l)			       
  fun atlist2str [] = ""
    | atlist2str ((aid,tp)::[]) = type2str(tp)^" "^aid
    | atlist2str ((aid,tp)::l) = type2str(tp)^" "^aid^", "^atlist2str(l)
  fun op2str(A.Plus)   = ("+",1)
    | op2str(A.Minus)  = ("-",1)
    | op2str(A.Times)  = ("*",0)
    | op2str(A.Divide) = ("/",0)
    | op2str(A.Modus)  = ("",0)
    | op2str(A.Band)   = ("/\\",1)
    | op2str(A.Bor)    = ("\\/",1)
    | op2str(A.Equ)    = ("=",0)
    | op2str(A.NEqu)   = ("&lt&gt",0)
    | op2str(A.GT)     = ("&gt",0)
    | op2str(A.GE)     = ("&gt=",0)
    | op2str(A.LT)     = ("&lt",0)
    | op2str(A.LE)     = ("&lt=",0)
  fun assert2str a =
      let fun lval2str(A.Var(id, _))           = (id, 0)
            | lval2str(A.Inptr(lval, _))       = let val (str,flag)=(lval2str lval)
					             val  lvastr = if flag=1 then (inpa str) else str
						 in  (lvastr,0)
						 end
            | lval2str(A.Inarray(lval, e, _))  = let val (str,flag)=(lval2str lval)
                                                     val (stre,flage) =(assert2str e) 
						     val lvalstr = if flag=1 then (inpa str) else str
						     val estr = if flage =1 then (inpa stre) else stre
					          in
						     (lvalstr^estr,0)
                                                  end
            | lval2str(A.Instruct(lval,id, _)) = let val (str,flag)=(lval2str lval)
                                                     val lvalstr = if flag=1 then (inpa str) else str
						 in
						     (lvalstr^"."^id,0)
                                                 end
            | lval2str(A.Ptstruct(lval,id, _)) = let val (str,flag)=(lval2str lval)
                                                     val lvalstr = if flag=1 then (inpa str) else str
						 in
						     (lvalstr^"->"^id,0)
                                                 end
            | lval2str (A.Ptstruct2 (lval1, id1, id2, pos)) =
              let val (str, flag) = lval2str lval1
                  val str2 = if flag = 1
                             then inpa str
                             else str
              in  (str2^"(->"^id1^")"^id2, 0)
              end
	  and a2s (A.Expvoid)   = (setfont2red "VOID", 0)
            | a2s (A.IntNum(i)) = ((Int.toString i),0)
            | a2s (A.True)      = (setfont2keyword "True",0)
            | a2s (A.False)     = (setfont2keyword "False",0)
            | a2s (A.Null)      = (setfont2red "NULL",0)
            | a2s (A.Lval(lval))=  let val (str,flag)=(lval2str lval)
                                                 val estr = if flag=1 then (inpa str) else str
				   in
					(estr, 0)
                                   end
            | a2s (A.BinopExp(e1, b, e2,_)) = let val (str1,flag1)=(assert2str e1)
                                                  val (str2,flag2) =(assert2str e2) 
                                                  val (opstr,flago) = (op2str b)
						  val e1str = if flag1=1 then (inpa str1) else str1
						  val e2str = if flag2=1 then (inpa str2) else str2
						  val resstr = if flago = 1
							       then (inpa (e1str^opstr^e2str)) 
							       else (e1str^opstr^e2str)
					       in
						     (resstr, 0)
                                               end
            | a2s (A.NotExp(e,_))    =  let val (str,flag)=(assert2str e)
                                                 val estr = if flag=1 then (inpa str) else str
					     in
						 ("!"^estr,0)
                                             end
            | a2s (A.Result)    = (setfont2red "res",0)
            | a2s (A.Imply(e1,e2,_))    = let val (str1,flag1)=(assert2str e1)
                                              val (str2,flag2) =(assert2str e2) 
                                              val e1str = if flag1=1 then (inpa str1) else str1
					      val e2str = if flag2=1 then (inpa str2) else str2
					  in
					      (e1str^"->"^e2str, 1)
                                          end
            | a2s (A.Forall(id,ty,e,_)) = let val (str,flag)=(assert2str e)
                                              val e1str = if flag=1 then (inpa str) else str
					  in
					      ((setfont2keyword "forall ")^id^" : int."^e1str, 1)
                                          end
            | a2s (A.Exists(id,ty,e,_)) = let val (str,flag)=(assert2str e)
                                              val e1str = if flag=1 then (inpa str) else str
					  in
					      ((setfont2keyword "exists ")^id^" : int."^e1str, 1)
                                          end 
            | a2s (A.Pi(lvalistlist,_)) = ("PI",0)
            | a2s (A.N(lvalist,_))     = ("N",0)
            | a2s (A.D(lvalist,_))     = ("D",0) 
            | a2s (A.Prev(lval,_))     = ("Prev",0) 
            | a2s (_)                 = ("",0)
         
      in  
	  (a2s a)
      end
  fun paldoc astnode =
      (*!Err.fileName*)
      let val docfilename = (!Err.fileName)^".html"
          val dochtmlhead = "<html><head><title>"^docfilename^"</title></head><body>"
	  val dochtmlfoot = "</body></html>"
          fun getdoc (A.ExdecSkip) = ""
            | getdoc (A.ExdecSeq(node1, node2, _ )) =
		let val doc1 = getdoc node1
                    val doc2 = getdoc node2
                    val docbetween = "<br>"
		in 
                    doc1^docbetween^doc2
                end
            | getdoc (A.ExdecStruct(_,_,_)) = ""
            | getdoc (A.ExdecVar(_,_)) = ""
            | getdoc (A.ExdecFunc (fid,rtp,fargs,vdec,stm,prec,postc,_)) = 
	      let val funcname = fid
                  val fnh2   = ((seth2 funcname))
                  val fdecl  = ((seth3 (type2str(rtp)^" "^funcname^"("^atlist2str(fargs)^")")))
		  val ftitle = (setline ("Function Name : "^funcname))		  
                  val rettp  = (setline ("Return Type   : "^(type2str rtp))) 
	          val args   = (setline ("Arguments     : "^(tlist2str fargs)))
	          val (prestr,_) = assert2str prec
                  val (posstr,_) = assert2str postc 
                  val precon = (setline ("Precondition  : "^prestr))
                  val postcon =(setline ("Postcondition : "^posstr))
	      in
		  fnh2^fdecl^ftitle^rettp^args^precon^postcon
              end          
          val content = dochtmlhead^(getdoc astnode)^dochtmlfoot
          val docfile = TextIO.openOut(docfilename) 
      in
          TextIO.output(docfile, content);
          TextIO.closeOut(docfile)
      end

end